module Emit (make_c) where
import Common
import Data.Char (chr)
import Data.Word

parenstr, modstr :: (Num a, Ord a) => String -> a -> String
modstr str n 
 | n > 0 = str ++ " += " ++ show n
 | n < 0 = str ++ " -= " ++ show (abs n)
 | otherwise = ""

parenstr str n
 | n > 0     = "*(" ++ str ++ "+" ++ show n ++ ")"
 | n < 0     = "*(" ++ str ++ "-" ++ show (abs n) ++ ")"
 | otherwise = '*':str

chrShow i 
 | i >= 255 || i <= 0 = show $ wChr i
 | otherwise = show (chr i)

wChr c
 | c < 0 = chr (fromIntegral ((fromIntegral c) :: Word8))
 | c >= 255 || c < 0 = error $ "chr of " ++ show c ++ " doesn't work"
 | otherwise = chr c

op_to_c :: Operation -> String
op_to_c (MoveOp m) = modstr "ptr" m ++ ";"
op_to_c (PutcOp (Const i)) = "putchar(" ++ chrShow i ++ ");"
op_to_c (PutcOp (Ptr o)) = "putchar(" ++ parenstr "ptr" o ++ ");"
op_to_c (PutcOp (Str lst)) = "fwrite(" ++ show (map wChr lst) ++ ", 1, " ++ show (length lst) ++ ", stdout);"
op_to_c (GetcOp) = "*ptr = getchar();"
op_to_c (LoopOp While b) = "while (*ptr) {\n" ++ (lineJoin . filter (/= ";") . map op_to_c) b ++ "}"
op_to_c (LoopOp DoWhile b) = "do { " ++ (lineJoin . filter (/= ";") . map op_to_c) b ++ "\n} while (*ptr);"
op_to_c (LoopOp If b) = "if(*ptr) {\n" ++ (lineJoin . filter (/= ";") . map op_to_c) b ++ "}"
op_to_c (off :+= val) = modstr (parenstr "ptr" off) val ++ ";"
op_to_c (off :<- val) = parenstr "ptr" off ++ " = " ++ show val ++ ";"
op_to_c (OpLocAddT dest src 1)   = parenstr "ptr" dest ++ " += " ++ parenstr "ptr" src ++ ";"
op_to_c (OpLocAddT dest src (-1))   = parenstr "ptr" dest ++ " -= " ++ parenstr "ptr" src ++ ";"
op_to_c (OpLocAddT dest src mul) 
  | mul > 0   =  parenstr "ptr" dest ++ " += " ++ parenstr "ptr" src ++ " * " ++ show mul ++ ";"
  | otherwise =  parenstr "ptr" dest ++ " -= " ++ parenstr "ptr" src ++ " * " ++ show (abs mul) ++ ";"
op_to_c (OpLocSetT dest src 1)   = parenstr "ptr" dest ++ " =  " ++ parenstr "ptr" src ++ ";"
op_to_c (OpLocSetT dest src mul) = parenstr "ptr" dest ++ " =  " ++ parenstr "ptr" src ++ " * " ++ show mul ++ ";"

to_c :: [Operation] -> String
to_c = lineJoin . map op_to_c

make_c :: [Operation] -> String
make_c v = "#include <stdio.h>\n#include <memory.h>\nint main(void) {\nchar buf[10000];\nchar *ptr = buf;\nmemset(buf,0,10000);\n"
     ++ to_c v ++ "\nreturn 0;\n}"


{-
stTest = evalState (boo [GetcOp,IncOff 0 1, LoopOp [IncOff 0 (-1), PutcOp, GetcOp, IncOff 0 1]]) 0
-- ,+[-.,+]

boo lst = do 
          r <- mapM tostr lst
          return $ lineJoin r

tostr op = do 
   s <- strSt
   case op of
     PutcOp -> return $ "putchar(buf[" ++ s ++ "]);"
     GetcOp -> return $ "buf[" ++ s ++ "] = getchar();"
     MoveOp m -> modify ((+) m) >> return "/* update */"
     SetOff o v -> 
               do sv <- get
                  return $ "buf[" ++ show (sv+o) ++ "] = " ++ show v ++ ";"
     IncOff o v ->
               do sv <- get
                  return $ "buf[" ++ show (sv+o) ++ "] += " ++ show v ++ ";"
     LoopOp b -> 
               do inner <- boo b 
                  newval <- get
                  return $ "int i = " ++ s ++ ";\nwhile (buf[i]) { " ++ inner ++ "/* " ++ show newval ++ "*/ };"
     OpLocAddT dest src mul -> 
               do sv <- get
                  return $ "buf[" ++ show (sv+dest)  ++ " += buf[" ++ show (sv+src) ++ " * " ++ show mul ++ ";"
    
     

strSt = get >>= return . show
 
runIndexed lst = 
 where run' (x:xs) s = run' xs (st_to_c s x)
       run' [] s = s  
st_to_c (i,last) GetcOp = (i, ("buf[" ++ show i ++ "] = getchar();"):last)
st_to_c (i,last) PutcOp = (i, ("putchar( buf[" ++ show i ++ "]);"):last)
-}
